home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Especial Multimedia
/
Especial Multimedia.iso
/
Multimed
/
Prg
/
IMAGELIB.ZIP
/
MIMAGE.ZIP
/
UBLOB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-26
|
16KB
|
532 lines
{Part of Imagelib VCL/DLL Library.
Written by Jan Dekkers and Kevin Adams}
unit Ublob;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DB, DBTables, reg_im20, StdCtrls, ExtCtrls, DBCtrls,
Gauges, Mask, Buttons, Clipbrd, Spin, U_p_size, Printers, Ufullscr, UAbout;
type
TForm1 = class(TForm)
Table1 : TTable;
DataSource1 : TDataSource;
DBNavigator1 : TDBNavigator;
TDBMultiImage1 : TDBMultiImage;
Gauge1 : TGauge;
AutodisplayCheckBox : TCheckBox;
DBEdit1 : TDBEdit;
StretchCheckBox : TCheckBox;
BitBtn1: TBitBtn;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
CenterCheckBox: TCheckBox;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
Timer1: TTimer;
BitBtn6: TBitBtn;
Edit1: TEdit;
BitBtn3: TBitBtn;
OpenDialog2: TOpenDialog;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit7: TEdit;
Label7: TLabel;
Edit8: TEdit;
GroupBox2: TGroupBox;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
SaveDialog2: TSaveDialog;
GroupBox3: TGroupBox;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Label8: TLabel;
Label9: TLabel;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
PrintDialog1: TPrintDialog;
BitBtn11: TBitBtn;
BitBtn12: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure AutodisplayCheckBoxClick(Sender: TObject);
procedure StretchCheckBoxClick(Sender: TObject);
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ResolutionClick(Sender: TObject);
procedure CenterCheckBoxClick(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure RadioButton4Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
procedure BitBtn12Click(Sender: TObject);
private
{ Private declarations }
procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure CallMe(i : integer); export; {CallBack Function MUST be exported}
begin
{Update the gauge}
Form1.Gauge1.Progress:=i;
{Be nice to other hard and software}
Application.ProcessMessages;
end;
function JustPathname(PathName : string) : string;
{-Return just the drive:directory portion of a pathname}
var
I : Word;
const
DosDelimSet : set of Char = ['\', ':', #0];
begin
I := Succ(Word(Length(PathName)));
repeat
Dec(I);
until (PathName[I] in DosDelimSet) or (I = 0);
if I = 0 then
{Had no drive or directory name}
JustPathname[0] := #0
else if I = 1 then
{Either the root directory of default drive or invalid pathname}
JustPathname := PathName[1]
else if (PathName[I] = '\') then begin
if PathName[Pred(I)] = ':' then
{Root directory of a drive, leave trailing backslash}
JustPathname := Copy(PathName, 1, I)
else
{Subdirectory, remove the trailing backslash}
JustPathname := Copy(PathName, 1, Pred(I));
end else
{Either the default directory of a drive or invalid pathname}
JustPathname := Copy(PathName, 1, I);
end;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
{Assign a callback function to the VCL/DLL}
TDBMultiImageCallBack:=CallMe;
{Is Autodisplay Initial on or off}
TDBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
{If the image data is changed save the blob to a jpeg or Bmp blob}
TDBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
{set the values of teh spin edit controls to the values of the vcl}
SpinEdit2.Value:=TDBMultiImage1.JPegSaveSmooth;
SpinEdit1.Value:=TDBMultiImage1.JPegSaveQuality;
(*
{Show the database open dialogbox}
BitBtn3Click(Sender);
*)
end;
procedure TForm1.AutodisplayCheckBoxClick(Sender: TObject);
begin
{Toggle Autodisplay}
TDBMultiImage1.AutoDisPlay:=AutodisplayCheckBox.Checked;
{Let users know to double click when autodisplay is off}
TDBMultiImage1.ShowHint:= not AutodisplayCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.StretchCheckBoxClick(Sender: TObject);
begin
{Stretch DBImage}
TDBMultiImage1.Stretch:=StretchCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.CenterCheckBoxClick(Sender: TObject);
begin
{Center DBImage}
TDBMultiImage1.Center:=CenterCheckBox.Checked;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
{Reset the Gauge}
Gauge1.Progress:=0;
{If TDBMultiImage1.autodisplay = false then get the blob info
manually else the vcl will do it automatically}
If not TDBMultiImage1.autodisplay then TDBMultiImage1.GetInfoAndType;
{Show the user the blob info}
Edit1.text:='This blob image is a '+TDBMultiImage1.BFiletype;
Edit2.text:=IntToStr(TDBMultiImage1.Bwidth);
Edit3.text:=IntToStr(TDBMultiImage1.BHeight);
Edit4.text:=IntToStr(TDBMultiImage1.Bbitspixel);
Edit5.text:=IntToStr(TDBMultiImage1.Bplanes);
Edit6.text:=IntToStr(TDBMultiImage1.Bnumcolors);
Edit7.text:=TDBMultiImage1.Bcompression;
Edit8.text:=IntToStr(TDBMultiImage1.BSize);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
{load a image file in the current blob}
If OpenDialog1.Execute Then begin
{Place table in edit mode}
Table1.Edit;
{Load the image from file into the blob}
TDBMultiImage1.LoadFromFile(OpenDialog1.FileName);
{Post the blob}
Table1.Post;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var temp : string;
begin
{Save the current blob to a jpeg, pcx, gif or Bmp file. The SaveToFile
will save it as stored in the blob. (no conversion is done here)
Use SaveToFileAsBMP or SaveToFileAsJpeg to Convert to one another}
{get the extension (filetype) of the stored blob}
{GetInfoAndType returns the extension of the blob stored}
if not table1.active then exit;
temp:=TDBMultiImage1.GetInfoAndType;
if temp = 'GIF' then begin
{set SaveDialog filter to display gif's only}
SaveDialog1.filter:='GIF files|*.GIF';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='GIF';
end else
if temp = 'PCX' then begin
{set SaveDialog filter to display pcx's only}
SaveDialog1.filter:='PCX files|*.PCX';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='PCX';
end else
if temp = 'JPG' then begin
{set SaveDialog filter to display jpeg's only}
SaveDialog1.filter:='Jpeg files|*.JPG';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='JPG';
end else
if temp = 'BMP' then begin
{set SaveDialog filter to display bmp's only}
SaveDialog1.filter:='BMP files|*.BMP';
{set SaveDialog Default extension}
SaveDialog1.DefaultExt:='BMP';
end;
{save it to file as stored in blob}
If SaveDialog1.Execute Then
TDBMultiImage1.SaveToFile(SaveDialog1.FileName);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.ResolutionClick(Sender: TObject);
begin
{Set resolution and dither the image}
if RadioButton1.Checked then begin
{Set resolution to 16 colors}
TDBMultiImage1.JpegResolution:=4;
{Set dither 1 pass ordered}
TDBMultiImage1.JpegDither:=2;
end else
if RadioButton2.Checked then begin
{Set resolution to 256 colors}
TDBMultiImage1.JpegResolution:=8;
{Set dither 2 pass FS}
TDBMultiImage1.JpegDither:=4;
end else
if RadioButton3.Checked then begin
{Set resolution to true color}
TDBMultiImage1.JpegResolution:=24;
{Set No dither (True color images don't have a palette)}
TDBMultiImage1.JpegDither:=0;
end;
{Reload the image }
Table1.Refresh;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
{Check to see if image is there}
if TDBMultiImage1.Picture.Bitmap <> nil then
{Copy the image to the clipboard}
TDBMultiImage1.CopyToClipboard;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
{Paste image from clipboard}
begin
{does the clipboard has the right format?}
if Clipboard.HasFormat(CF_PICTURE) then
{Yep it does. Paste image from clipboard}
TDBMultiImage1.PastefromClipboard;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
{En/Disable Paste Button if clipboard has format}
BitBtn5.Enabled:=Clipboard.HasFormat(CF_PICTURE);
{Enable/disable certain buttons}
{Button is only then enabled if table is active}
BitBtn1.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn2.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn4.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn6.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn7.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn8.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn9.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn10.Enabled:=Table1.Active;
{Button is only then enabled if table is active}
BitBtn11.Enabled:=Table1.Active;
{Box is only then visible if table is active and blob is a jpeg }
GroupBox1.Visible:=Table1.Active and (TDBMultiImage1.BFiletype = 'JPEG');
{Box is only then visible if table is active and field is in edit state}
GroupBox2.Visible:=Table1.Active and (DataSource1.State in [dsEdit, dsInsert]);
{Box is only then visible if table is active and field is in edit state and update is in jpeg mode}
GroupBox3.Visible:=Table1.Active and RadioButton4.Checked and (DataSource1.State in [dsEdit, dsInsert]);
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
{Append a record and store an image file into the blob}
If OpenDialog1.Execute Then begin
{Place table in edit mode}
Table1.Append;
{Load the image from file into the blob}
TDBMultiImage1.LoadFromFile(OpenDialog1.FileName);
{Post the blob}
Table1.Post;
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
{open the table}
If OpenDialog2.execute then begin
Table1.Active:=False;
Table1.DataBaseName:=JustPathname(OpenDialog2.FileName);
Table1.TableName:=OpenDialog2.FileName;
Table1.Active:=True;
end;
end;
procedure TForm1.RadioButton4Click(Sender: TObject);
begin
{If the image data is changed save the blob to a jpeg or Bmp blob}
TDBMultiImage1.UpdateBlobAsJpeg:=RadioButton4.Checked;
{Hide or show the jpeg update/save options}
GroupBox3.Visible:=RadioButton4.Checked;
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
{save or convert the blob to a BMP file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display bmp's only}
SaveDialog2.filter:='BMP files|*.BMP';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='BMP';
if SaveDialog2.Execute then
{Save it}
TDBMultiImage1.SaveToFileAsBMP(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.BitBtn8Click(Sender: TObject);
{save or convert the blob to a Jpeg file}
{make sure that the blob is displayed before saving to file}
begin
{set SaveDialog filter to display jpeg's only}
SaveDialog2.filter:='Jpeg files|*.JPG';
{set SaveDialog Default extension}
SaveDialog2.DefaultExt:='JPG';
if SaveDialog2.Execute then
{Save it}
TDBMultiImage1.SaveToFileAsJpeg(SaveDialog2.Filename);
{reset the gauge to 0}
Gauge1.Progress:=0;
end;
procedure TForm1.SpinEdit2Change(Sender: TObject);
begin
{Set the smooth of the jpeg to save or upate a blob}
TDBMultiImage1.JPegSaveSmooth:=SpinEdit2.Value;
end;
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
{Set the quality of the jpeg to save or upate a blob}
TDBMultiImage1.JPegSaveQuality:=SpinEdit1.Value;
end;
procedure TForm1.BitBtn10Click(Sender: TObject);
begin
{Initialize the height spinedit of the printsize dialog box}
Printersize.HeigthSpinEdit.Value:=TDBMultiImage1.BHeight;
{Initialize the width spinedit of the printsize dialog box}
Printersize.WidthSpinEdit.Value:=TDBMultiImage1.BWidth;
{reset the original size radio button}
RadioButton1.Checked:=True;
{Show it}
Printersize.ShowModal;
{Hide it if done}
Printersize.hide;
end;
procedure TForm1.BitBtn9Click(Sender: TObject);
begin
if PrintDialog1.execute then begin
{Sent the doc to the printer}
Printer.Begindoc;
{Print the TDBMultiImage bitmap}
PrintBitmap(TDBMultiImage1.Picture.Bitmap,0,0);
{End the printjob and close the bitmap}
Printer.Enddoc;
end;
end;
procedure TForm1.PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var
Info: PBitmapInfo;
InfoSize: Integer;
Image: Pointer;
ImageSize: Longint;
begin
{Print using borland's how to print a bitmap example code}
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := MemAlloc(InfoSize);
try
Image := MemAlloc(ImageSize);
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do begin
if (Printersize.HeigthSpinEdit.Value >1) and (Printersize.WidthSpinEdit.Value >1) then
StretchDIBits(Printer.Canvas.Handle, X, Y, Printersize.WidthSpinEdit.Value,
Printersize.HeigthSpinEdit.Value, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY)
else
StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
end;
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;
procedure TForm1.BitBtn11Click(Sender: TObject);
begin
{copy DB Blob image to fullscreen image}
FullSlide.MultiImage1.Picture.Graphic:=TDBMultiImage1.Picture.Graphic;
{show the image fulscreen}
FullSlide.showmodal;
end;
procedure TForm1.BitBtn12Click(Sender: TObject);
{about box}
begin
{Copy the image to the image of he about box}
AboutBox.Image1.Picture.Graphic:=TDBMultiImage1.Picture.Graphic;
{show the about box}
AboutBox.showmodal;
end;
end.